HPAVC/HPAVC CD-ROM.iso/pc/BOI200P.ZIP/IOLIB.PAS

Pascal/Delphi Source File | 1992-12-14 | 42.8 KB | 1,070 lines

{ $D-}
{$S-}
{$V-}

Unit IOLib;
{ Part of BBS Onliner Interface                                                }
{ Copyright (C) 1990,1992 Andrew J. Mead                                       }
{ All Rights Reserved.                                                         }

{ BBS Onliner Interface contains                                               }
{ Async     - low-level serial port communications interrupt handler           }
{ BOIDecl   - BOI standard declarations                                        }
{ IOLib     - standard console and port communications routines                }
{ IOSupp    - extended character code processing for IOLib.ReadPortKey         }
{ GetCmBBS  - command line parser and dropfile processing                      }
{ Support   - common library functions and procedures                          }
{ DoorLib   - information about door                                           }
{ Key       - registration key code shell                                      }

{  Original version 7/1/90                                                      }
{  Original release version 1.0 beta 9/5/90                                    }
{  Vers 1.01  9/19/90 /Q quiet local mode switch added                         }
{  Vers 1.01b 9/20/90 realname usage added, /A Remote Access defined           }
{  Vers 1.02  9/22/90 RA access removed, /Q switch fixed                       }
{  Vers 1.03  9/23/90 /A play it Again switch added                            }
{  Vers 1.10  9/24/90 /2, /F, /M, /H, /5, /6 switches added                    }
{  Vers 1.11  9/29/90 beta version of /B locked baud rate                      }
{  Vers 1.12 10/ 1/90 /P switch added                                          }
{  Vers 1.13 10/10/90 /N switch added                                          }
{  Vers 1.14 10/22/90 /B switch fixed, carrier dectect routines added          }
{  Vers 1.15 10/25/90 internal reorginizations, /K added                       }
{  Vers 1.16 11/ 9/90 /K fixed, F-9 abort added.                               }
{  Vers 1.17 12/ 1/90 internal reorginizations.                                }
{  Vers 1.17b12/ 5/90 /P fixed, /O implemented                                 }
{  Vers 1.18 12/ 9/90 /O,/P verified /1,/3 implemented.                        }
{  Vers 1.20 12/10/90 Initial Public Release of BBS Onliner Interface.         }
{  Vers 1.21  2/25/91 Minor cosmetic changes                                   }
{  Vers 1.22  4/ 7/91 PortBackground bug fixed.                                }
{                     Delay rewritten.                                         }
{  Vers 1.23  4/13/91 initialization and IOExit added.                         }
{  Vers 1.24  5/11/92 ANSI routines modified, DisplayText added                }
{                     GetCommand command line parsing bug fixed.               }
{  Vers 1.25  5/19/92 CRT unit support added... release version                }
{  Vers 1.26  5/20/92 more fun                                                 }
{  Vers 1.27  6/11/92 registration keys added, DESQview support enhanced...    }
{  Vers 1.28  6/13/92                                                          }
{  Vers 1.29  6/15/92 timer interrupt added, Windoze, OS/2 awareness           }
{  Vers 1.30  7/ 1/92 release version                                          }
{  Vers 1.31  7/19/92 color routines optimized, TextAttr implemented           }
{  Vers 1.32  7/24/92 Endgame bug fixed, Status Line handling improved         }
{                     Local function key handling improved (BOI > 3000 lines)  }
{                     Time remaining bug fixed                                 }
{  Vers 1.33  8/ 4/92 Hall of Fame bug fixed, (ONE BBSCON) release version     }
{  Vers 1.34  8/12/92 Another Hall of Fame bug fixed, release version          }
{  Vers 1.35  8/16/92 /P fixed                                                 }
{  Vers 1.36  8/17/92 FOSSIL routines implemented, AVATAR routines added       }
{  Vers 1.37  8/18/92 additional PCBoard support added                         }
{  Vers 1.38  8/26/92 minor code tightening, Minefield release                 }
{  Vers 1.39 11/12/92 variables renamed and standardized, commenting improved  }
{  Vers 1.40 11/19/92 known bugs squashed, more drop file formats added        }
{  Vers 2.00 12/14/92 Public Release of the BBS Onliner Interface              }
{                                                                              }
{ To be done (short list):                                                     }
{   Activity logging (2.1?)                                                    }
{   Enhanced Error trapping and logging (2.1?)                                 }
{   Natural language files support (2.2?)                                      }
{   Config file script language (3.0)                                          }
{   Record Locking (2.2-3.0)                                                   }
{                                                                              }
{ Long range possibilities                                                     }
{   object orientation (2.1...)                                                }
{   add comm routines for multiport boards (need info)                         }
{   use of TP7 .DLLs for multinode play! (2.2...)                              }
{   take advantage of TP7 pchars and other new stuff (2.1)                     }
{   OS/2 version (either Claris Pascal or C/C++) (compiler availability)       }
{   WinNT version (compiler availability)                                      }
{                                                                              }

INTERFACE

Uses
  BOIDecl,
  Crt,
  Dos;

{ Basic Functions }
  Function MIN(a,b : word) : word;
  Function MAX(a,b : word) : word;
  Function MINL(a,b : longint) : longint;
  Function MAXL(a,b : longint) : longint;
  Function HEX(hexchar : char) : byte;

{* Internal Timing *}
  Procedure TIMERSET(var basetime : longint);
  Function GETTIMER(var basetime : longint; val : word) : boolean;

{* File Validation and Access *}
  Function EXIST(thisfile : pathstr) : boolean;
  Function VALID(thisfile : pathstr) : boolean;
  Procedure NOTIFYSYSOP(nfile : pathstr);
  Function OPENFILE(var f:file;fsize:word;fmode:byte;faccess:facctype) : word;
  Function OPENTEXT(var f : text; fmode : byte; faccess : facctype) : word;

{ Output and String Functions }
  Procedure SENDREMOTE(outstr : string);
  Procedure SENDLOCAL(outstr : string);
  Procedure SENDSTRING(outstr : string; docr : boolean);
  Function INTSTR(val : longint; isize : byte) : string;
  Function REALSTR(rval : real; rsize, rdec : byte) : string;
  Function PADSTR(pstr : string; psize : byte) : string;
  Procedure CLEANSTRING(var clean : string);
  Procedure STRIPSTRING(var stripstr : string; stripset : charset);
  Procedure GETSTRING(var gstr : string);

{ Housecleaning }
  Function SETPORT : byte;

{ Display - Positional/Attribute }
  Procedure SETLOCALGRAPHMODE(newmode : boi_grmode);

  Procedure GOTOPORTXY(x,y : byte);
  Procedure PORTCOLOR(acolor, bcolor : byte);
  Procedure TEXTPORTCOLOR(color : byte);
  Procedure PORTBACKGROUND(color: byte);
  Procedure GETTEXTATTR(var attribs : word);
  Procedure SETTEXTATTR(attribs : word);
  Procedure CHANGECOLOR(attribs : word);
  Procedure UPDATESTATLINE;
  Procedure CLRPORTSCR;
  Procedure CLRPORTEOL;
  Procedure PORTWINDOW(x1,y1,x2,y2 : byte);
  Procedure PORTCOLUMNONE;

{ Input Functions }
  Function READPORTKEY : char;
  Function PORTKEYPRESSED : boolean;
  Procedure CLEARBUFFERS;

{ Advanced Cursor functions }
  Procedure SETPORTXY;
  Procedure RESETPORTXY;

{ Timeout procedure }
  Function  LEFTTIME : integer;
  Procedure DOTIMEOUT(ringbell : boolean);

IMPLEMENTATION

Uses
  IOSupp,
  Async;

Const
  null  = #$00;
  bell  = #$07;
  ctrla = #$01; {AVATAR attrib}
  ctrlb = #$02; {AVATAR blink}
  ctrle = #$05;
  ctrlg = #$07; {AVATAR ClrEOL}
  ctrlh = #$08; {AVATAR GotoXY}
  ctrll = #$0C;
  ctrlv = #$16;
  ctrlw = #$17; {AVATAR Switch Window}
  ctrly = #$19; {AVATAR repeat}
  esc   = #$1B;

  io_trylim = 10;                { file locked retry limit }

  io_basex  : byte =  1;         { internal cursor positioning variables }
  io_basey  : byte =  1;
  io_endx   : byte = 80;
  io_endy   : byte = 24;
  io_tempx  : byte =  1;
  io_tempy  : byte =  1;

  io_l_avwin : byte = $00;       { active AVATAR/1 window (local)  }
  io_r_avwin : byte = $00;       { active AVATAR/1 window (remote) }

Var
  io_regs       : registers;     { general purpose temporary registers }
  io_keyregs    : registers;

  io_workstr    : string;        { general purpose temporary variables }
  io_tempbyte   : byte;
  io_tempchar   : char;

  io_l_textattr : byte;          { current local text attributes  }
  io_r_textattr : byte;          { current remote text attributes }

Function MIN(a, b : word) : word;   { returns the minimum of two Word values }
  begin {* fMin *}
    if a < b then Min := a else Min := b
  end;  {* fMin *}

Function MAX(a, b : word) : word;   { returns the maximum of two Word values }
  begin {* fMax *}
    if a > b then Max := a else Max := b
  end;  {* fMax *}

Function MINL(a, b : longint) : longint; { returns smaller longit value }
  begin {* fMinL *}
    if a < b then MinL := a else MinL := b
  end;  {* fMinL *}

Function MAXL(a, b : longint) : longint; { returns larger longit value }
  begin {* fMaxL *}
    if a < b then MaxL := a else MaxL := b
  end;  {* fMaxL *}

Function HEX(hexchar : char) : byte; { converts hex character into byte }
  var
    hexbyte : byte absolute hexchar;

  begin {* fHex *}
    if hexchar in ['0'..'9'] then Hex := hexbyte AND $0F
    else Hex := (hexbyte AND $0F) + $09
  end;  {* fHex *}

Procedure TIMERSET(         { used with GetTimer for elapsed time routines }
  var basetime : longint);    { variable to assign current time value to }

  begin {* TimerSet *}
    basetime := boi_timer;
  end;  {* TimerSet *}

Function GETTIMER(          { true if "val" seconds since TimerSet(basetime) }
  var basetime : longint;     { variable assigned by TimerSet }
      val : word) : boolean;  { target number of seconds elapsed }

  begin {* GetTimer *}
    GetTimer := (boi_timer - basetime) / 18.2 > val
  end;  {* GetTimer *}

Function OPENFILE(               { open an untyped file, returns IOResult }
  var f       : file;              { file handle }
      fsize   : word;              { record size }
      fmode   : byte;              { file sharing mode }
      faccess : facctype) : word;  { file opening mode }
  const
    busy      = 5;               { IOResult DOS file busy return code }
  var
    result    : word;            { result of attempt to open file }
    tries     : byte;            { locked file retries count }

  begin {* fOpenFile *}
    filemode := fmode;
    if not dos_share then filemode := filemode AND $07;
    tries := 0;
    {$I-}                                    { we'll do our own checking }
    repeat
      begin
        Inc(tries);
        case faccess of                      { attempt to open file }
            treset   : Reset(f,fsize);
            trewrite :
              begin
                Rewrite(f,fsize);
                Close(f);
                Reset(f,fsize)
              end
          end;
        result := IOResult;                  { was it successful? }
        if result = busy then if not in_dos^ then BOI_Wait
                              { if busy, then give up rest of timer tick }
      end
    until (result <> busy) or ((tries >= io_trylim) and (result = busy));
    {$I+}
    OpenFile := result
  end;  {* fOpenFile *}

Function OPENTEXT(               { open an untyped file, returns IOResult }
  var f       : text;              { file handle }
      fmode   : byte;              { file sharing mode }
      faccess : facctype) : word;  { file opening mode }
  const
    busy      = 5;               { IOResult DOS file busy return code }
  var
    result    : word;            { result of attempt to open file }
    tries     : byte;

  begin {* fOpenText *}
    filemode := fmode;
    if not dos_share then filemode := filemode AND $07;
    tries := 0;
    {$I-}                        { we'll do the error checking }
    repeat
      begin
        Inc(tries);              { try to open the file }
        case faccess of
            treset   : Reset(f);
            trewrite : Rewrite(f);
            tappend  : Append(f)
          end;
        result := IOResult;      { did it work? }
        if result = busy then if not in_dos^ then BOI_Wait
                                 { if it was busy, then wait }
      end
    until (result <> busy) or ((tries >= io_trylim) and (result = busy));
    {$I+}
    OpenText := result
  end;  {* fOpenText *}

Procedure NOTIFYSYSOP(    { file not found!  Tell user to bother SysOp }
    nfile : pathstr);       { file that wasn't found }

  begin {* NotifySysOp *}
    PortWindow(1,1,80,boi_pagelength);
    ClrPortScr;
    PortColor(cyan,lightgray);
    PortBackground(black);
    SendString('Unable to find the file : ',false);
    TextPortColor(white);
    SendString(nfile,true);
    PortColor(cyan,lightgray);
    SendString('Please notify SysOp.  Press almost any key to continue.',false);
    ClearBuffers;
    io_tempchar := ReadPortKey
  end;  {* NotifySysOp *}

Function EXIST(                     { Check for files existence }
    thisfile : pathstr) : boolean;    { filespec for file to check }
  var
    afile    : file;                  { temporary file handle }
    isfile   : boolean;               { temporary result holder }

  begin {* fExist *}
    Assign(afile,thisfile);
    isfile := OpenFile(afile,1,denynone+read_only,treset) = 0;
    if isfile then Close(afile);
    Exist := isfile
  end;  {* fExist *}

Function VALID(                     { Check filespec for validity }
    thisfile : pathstr) : boolean;    { filespec to check }
  var
    afile    : file;                  { temporary file handle }
    isgood   : boolean;               { temporary result holder }

  begin {* fValid *}
    if not Exist(thisfile) then     { if the file Exists, then it is Valid }
      begin
        Assign(afile,thisfile);
        isgood := OpenFile(afile,1,denynone+read_only,trewrite) in [0,163];
        if isgood then
          begin
            Close(afile); { if the filespec is Valid, but it did }
            Erase(afile)  { not Exist, we just created one!!!    }
          end;
        Valid := isgood
      end
    else Valid := true
  end;  {* fValid *}

{ this procedure should really only be called by SendString }
Procedure SENDREMOTE(      { send character(s) to remote with wait }
    outstr : string);        { string to send }

  begin {* SendRemote *}
    for io_tempbyte := 1 to Length(outstr) do SendChar(outstr[io_tempbyte])
  end;  {* SendRemote *}

{ this procedure should really only be called by SendString }
Procedure SENDLOCAL(       { send character(s) to local console }
    outstr : string);        { string to send }

  begin {* SendLocal *}
    Write(outstr)
  end;  {* SendLocal *}

Procedure SENDSTRING(      { general output procedure }
    outstr : string;         { string to output }
    docr   : boolean);       { output newline indicator }

  begin {* SendString *}
    if docr then outstr := outstr + #$0D#$0A;   { append CR/LF }
    if not boi_local then SendRemote(outstr);
    if boi_local or boi_echo then
      begin
        { if quiet mode, then strip ^Gs (bells) from output string }
        if boi_quiet then for io_tempbyte := Length(outstr) downto 1 do
            if outstr[io_tempbyte] = bell then Delete(outstr,io_tempbyte,1);
        SendLocal(outstr)
      end
  end;  {* SendString *}

Function INTSTR(             { takes integer value and returns string }
    val   : longint;           { value to convert }
    isize : byte) : string;    { size of output string }
  var
    ist   : string;            { temporary string variable }

  begin {* fIntStr *}
    Str(val:isize,ist);
    IntStr := ist
  end;  {* fIntStr *}

Function REALSTR(            { takes real value and returns string }
    rval  : real;              { value to convert }
    rsize : byte;              { size of output string }
    rdec  : byte) : string;    { number of decimal spaces in output string }
  var
    ist   : string;            { temporary string variable }

  begin {* fRealStr *}
    Str(rval:rsize:rdec,ist);
    RealStr := ist
  end;  {* fRealStr *}

Function PADSTR(             { pad text string out to psize spaces }
    pstr  : string;            { string to right justify }
    psize : byte) : string;    { size of output string }
  var
    tstr  : string;            { temporary string variable }

  begin {* fPadStr *}
    if Length(pstr) > psize then PadStr := pstr
    else
      begin
        FillChar(tstr[1],psize,32);
        tstr[0] := Chr(psize);
        Move(pstr[1],tstr[psize - Length(pstr) + 1],Length(pstr));
        PadStr := tstr
      end
  end;  {* fPadStr *}

Procedure CLEANSTRING(   { remove whitespace from front and back of string }
  var clean : string);     { string to clean }

  begin {* CleanString *}
    while (Length(clean) > 0) and (clean[1] = ' ') do
        Delete(clean,1,1);
    while (Length(clean) > 0) and (clean[Length(clean)] = ' ') do
        Dec(clean[0])
  end;  {* CleanString *}

Procedure STRIPSTRING(     { remove specified characters from string }
  var stripstr : string;     { string to strip }
      stripset : charset);   { characters to remove from string }
  var
    sloop      : byte;

  begin {* StripString *}
    for sloop := Length(stripstr) downto 1 do
        if stripstr[sloop] in stripset then
        Delete(stripstr,sloop,1)
  end;  {* StripString *}

Function LOCALKEYPRESSED : boolean;
  { indicates whether or not key on local keyboard has been pressed }

  begin {* fLocalKeyPressed *}
    if KeyPressed then with io_keyregs do
      begin
        repeat       { remove all function keys from head of local buffer }
          begin
            AH := $01;  { peak at next character in buffer }
            Intr($16,io_keyregs);
            if AL = $00 then  { if it is a function key then... }
              begin
                AH := $00;  { get next character from buffer }
                Intr($16,io_keyregs);
                CheckSecondKey(Chr(AH)) { send it off for processing }
              end
          end
        until (not KeyPressed) or (AL <> $00);
        LocalKeyPressed := (AL <> $00)
      end
    else LocalKeyPressed := false    { local buffer is empty }
  end;  {* fLocalKeyPressed *}

Function READPORTKEY : char;    { returns (with wait) input character }
  var
    rkey     : char;            { input character }

  begin {* fReadPortKey *}
    boi_stall := 0;        { reset inactivity timeout value }
    if boi_local then      { if in local mode, then use this simpler routine }
      begin
        repeat BOI_Wait until LocalKeyPressed;
        rkey := ReadKey
      end
    else
      begin
        while not (CharReady or LocalKeyPressed or (boi_stall >= 1092) or
            not Carrier) do if not in_dos^ then
            BOI_Wait;
        if not (LocalKeyPressed or CharReady) and Carrier and
            (boi_stall >= 1092) then
          begin     { no activity for one minute }
            SendString(bell,false);   { send bell to wake up user }
            while not (CharReady or LocalKeyPressed or (boi_stall >= 2184) or
                not Carrier) do if not in_dos^ then
                BOI_Wait
          end;
        if not Carrier then DoTimeOut(false)   { see if user dropped carrier }
        else if not (LocalKeyPressed or CharReady) and
            (boi_stall >= 2184) then DoTimeOut(true) { two minutes-no activity }
        else if CharReady then rkey := ReadBuffer
        else if LocalKeyPressed then rkey := ReadKey
      end;
    ReadPortKey := rkey;
    boi_stall := 0      { reset inactivity timeout value }
  end;  {* fReadPortKey *}

Function PORTKEYPRESSED : boolean;   { is there input waiting? }
  begin {* fPortKeyPressed *}
    if boi_local then PortKeyPressed := LocalKeyPressed
    else PortKeyPressed := LocalKeyPressed or CharReady
  end;  {* fPortKeyPressed *}

Procedure CLEARBUFFERS;    { blank out local and remote input buffers }
  var
    cbchar : char;           { temporary input character }

  begin {* ClearBuffers *}
    while LocalKeyPressed do cbchar := ReadKey;
    if not boi_local then ClearInBuffer
  end;  {* ClearBuffers *}

Procedure GETSTRING( { return string of input characters up to next newline }
  var gstr : string);  { string to return }
  var
    gchar : char;    { temporary input character }

  begin {* GetString *}
    gstr := '';
    repeat
      begin
        if boi_nextchar = #$00 then
            gchar := ReadPortKey     { get character }
        else
          begin
            gchar := boi_nextchar;
            boi_nextchar := #$00
          end;
        if gchar in [#32..#126] then { test for validity }
          begin
            gstr := gstr + gchar;    { append character to string }
            SendString(gchar,false)  { echo character back out }
          end
        else if (gchar = #8) and (Length(gstr) > 0) then
          begin            { if backspace and string exists... }
            Delete(gstr,Length(gstr),1);
            SendString(gchar + ' ' + gchar,false)
          end
      end
    until gchar = #13;  { repeat until newline }
    SendString('',true) { echo newline }
  end;  {* GetString *}

{ This function should only be called by GetCmBBS }
Function SETPORT : byte;        { returns $00 if successful }
  const
    portset : boolean = false;

  begin {* fSetPort *}
    if portset then SetPort := $FF { return $FF if procedure already called }
    else
      begin
        portset := true;
        if boi_local then SetPort := $00 { local mode needs no initializing }
        else SetPort := IntInit     { call Async.IntInit }
      end
  end;  {* fSetPort *}

{ this should be used to set or change boi_l_grmode }
Procedure SETLOCALGRAPHMODE(   { sets up local console graphics mode }
    newmode : boi_grmode);

  begin {* SetLocalGraphMode *}
    boi_l_grmode := newmode;
    if boi_l_grmode = gr_tpcrt then
        directvideo := boi_tasker in [notask,dos5]
        { if no multi-tasker present, use direct screen writes }
        { otherwise use BIOS routines for local console }
    else
      begin
        directvideo := false; { send output through CONsole driver }
        Assign(output,'');
        ReWrite(output);
        if boi_l_grmode = gr_avt then  { additional AVATAR/1 set up }
          begin
            io_l_avwin := $00;     { current AVATAR window }
            checkbreak := false;
            SendLocal(ctrlv + '=R');  { define current AVATAR screen }
            SendLocal(ctrlv + ctrlv + Chr($FF) + Chr($03) + #25#01#25#80)
          end
      end
  end;  {* SetLocalGraphMode *}

Function AVSTR(value : byte) : string;
  begin
    if value <> value then AVStr := #10 + Chr(value)
    else AVStr := Chr(value)
  end;

Procedure GOTOPORTXY( { set current position }
    x : byte;           { column to move cursor to (1..80) }
    y : byte);          { row to move cursor to (1..25) }

  begin {* GotoPortXY *}
    if not boi_local then case boi_r_grmode of { position remote cursor }
        gr_ansi  : SendRemote(esc + '[' + IntStr(y + io_basey - 1,0) + ';' +
                                        IntStr(x + io_basex - 1,0) + 'H');
        gr_avt   : SendRemote(ctrlv + ctrlh + Chr(y + io_basey - 1) +
                                            Chr(x + io_basex - 1))
      end;
    if boi_local or boi_echo then case boi_l_grmode of {position local cursor}
        gr_ansi  : SendLocal(esc + '[' + IntStr(y + io_basey - 1,0) + ';' +
                                       IntStr(x + io_basex - 1,0) + 'H');
        gr_avt   : SendLocal(ctrlv + ctrlh + AvStr(y + io_basey - 1) +
                                           AvStr(x + io_basex - 1));
        gr_tpcrt : GotoXY(x,y)
      end
  end;  {* GotoPortXY *}

Procedure REMOTECOLOR(  { internal, sets remote text attributes }
    color : byte);        { new remote attributes }

  begin {* RemoteColor *}
    color := color AND $8F;  { blink must be set seperately }
    { only change color if new color is not current color }
    if (io_r_textattr AND $8F <> color) then case boi_r_grmode of
        gr_ansi : { ANSI processing }
          begin
            if color > $87 then { color is intense and blinking }
                SendRemote(esc+'['+IntStr(boi_ansiarr[color],0)+';01;05m')
            else if color > $7F then { color is intense }
                SendRemote(esc+'[00;'+IntStr(boi_ansiarr[color],0)+';05m')
            else if color > $07 then { color is blinking }
                SendRemote(esc+'[00;'+IntStr(boi_ansiarr[color],0)+';01m')
            else
                SendRemote(esc+'[00;'+IntStr(boi_ansiarr[color],0)+'m');
            if io_r_textattr AND $70 <> $00 then { change background color }
                PortBackground((io_r_textattr AND $70) SHR 4)
          end;
        gr_avt : { AVATAR processing }
          begin
            if color AND $80 = $80 then SendRemote(ctrlv + ctrlb);
            color := color AND $7F;
            SendRemote(ctrlv + ctrla + Chr(color))
          end
      end;
    io_r_textattr := (io_r_textattr AND $70) OR color {update text attribute}
  end;  {* RemoteColor *}

Procedure LOCALCOLOR(     { internal, sets local console text attributes }
    color : byte);          { new text attributes }

  begin {* LocalColor *}
    color := color AND $8F;
    { only change color if new color is not same as old color }
    if (boi_local or boi_echo) and (io_l_textattr AND $8F <> color) then
        case boi_l_grmode of
        gr_ansi : { ANSI processing }
          begin
            if color > $87 then { color is intense and blinking }
                SendLocal(esc+'['+IntStr(boi_ansiarr[color],0)+';01;05m')
            else if color > $7F then { color is intense }
                SendLocal(esc+'[00;'+IntStr(boi_ansiarr[color],0)+';05m')
            else if color > $07 then { color is blinking }
                SendLocal(esc+'[00;'+IntStr(boi_ansiarr[color],0)+';01m')
            else
                SendLocal(esc+'[00;'+IntStr(boi_ansiarr[color],0)+'m');
            if io_l_textattr AND $70 <> $00 then { change background color }
                PortBackground((io_l_textattr AND $70) SHR 4)
          end;
        gr_avt : { AVATAR processing }
          begin
            if color AND $80 = $80 then SendLocal(ctrlv + ctrlb);
            color := color AND $7F;
            SendLocal(ctrlv + ctrla + Chr(color))
          end;
        gr_tpcrt : TextColor(color) { direct video processing }
      end;
    io_l_textattr := (io_l_textattr AND $70) OR color {update text attribute}
  end;  {* LocalColor *}

Procedure PORTCOLOR(     { change current color conditional on color mode }
    acolor : byte;         { color to be if color mode }
    bcolor : byte);        { color to be if black/white mode }

  begin {* PortColor *}
    if not boi_local then { change remote color }
        if boi_r_color then RemoteColor(acolor)
        else RemoteColor(bcolor);
    if boi_local or boi_echo then { change local color }
        if boi_l_color then LocalColor(acolor)
        else LocalColor(bcolor);
  end;  {* PortColor *}

Procedure TEXTPORTCOLOR( { change current color absolute }
    color : byte);         { color to change to }

  begin {* TextPortColor *}
    if not boi_local then RemoteColor(color);        { change remote color }
    if boi_local or boi_echo then LocalColor(color)  { change local color }
  end;  {* TextPortColor *}

Procedure PORTBACKGROUND( { change text background color }
    color : byte);          { color for background to be }

  begin {* PortBackground *}
    color := color AND $07;
    if not boi_local then { change remote background color }
      begin
        if (color SHL 4) <> (io_r_textattr AND $70) then case boi_r_grmode of
            gr_ansi : if color in [0..7] then {must be valid background color}
                SendRemote(esc + '[' + IntStr(boi_ansiarr[color] + 10,0) + 'm');
            gr_avt :
                SendRemote(ctrlv + ctrla + Chr((io_r_textattr AND $0F) OR
                (color SHL 4)))
          end;
        io_r_textattr := (io_r_textattr AND $8F) OR (color SHL 4)
      end;
    if boi_local or boi_echo then { change local background color }
      begin
        if (color SHL 4) <> (io_l_textattr AND $70) then case boi_l_grmode of
            gr_ansi  : if color in [0..7] then {must be valid background color}
                SendLocal(esc + '[' + IntStr(boi_ansiarr[color] + 10,0) + 'm');
            gr_avt   :
                SendLocal(ctrlv + ctrla + Chr((io_l_textattr AND $0F) OR
                (color SHL 4)));
            gr_tpcrt : TextBackground(color)
          end;
        io_l_textattr := (io_l_textattr AND $8F) OR (color SHL 4)
      end
  end;  {* PortBackground *}

Type
  attype = array [0..1] of byte;

Procedure GETTEXTATTR(   { get current text attributes }
  var attribs : word);
  var
    atsplit   : attype absolute attribs;

  begin {* GetTextAttr *}
    atsplit[0] := io_r_textattr;
    atsplit[1] := io_l_textattr
  end;  {* GetTextAttr *}

Procedure SETTEXTATTR(   { set text attributes (does NOT change color) }
    attribs : word);
  var
    atsplit : attype absolute attribs;

  begin {* SetTextAttr *}
    io_r_textattr := atsplit[0];
    io_l_textattr := atsplit[1]
  end;  {* SetTextAttr *}

Procedure CHANGECOLOR(   { change color (by text attributes) }
    attribs : word);
  var
    atsplit : attype absolute attribs;

  { this is usually used as a restore with data from GetTextAttr }
  begin {* ChangeColor *}
    if not boi_local then
      begin
        RemoteColor(atsplit[0]);
        TextBackground((atsplit[0] AND $70) SHR 4)
      end;
    LocalColor(atsplit[1]);
    if boi_local or boi_echo then TextBackground((atsplit[1] AND $70) SHR 4)
  end;  {* ChangeColor *}

Procedure UPDATESTATLINE;  { updates user status line on local console }
  var
    cloop   : byte;
    tempmin : word;
    tempmax : word;
    tempstr : string;
    oldattr : word;

  begin {* UpdateStatLine *}
    if not boi_local then
      begin
        { initialize stat line }
        FillChar(io_workstr,SizeOf(io_workstr),' ');
        io_workstr := '[F2] toggle ';

        { add player's name to stat line }
        if boi_usename then io_workstr := io_workstr + boi_username
        else io_workstr := io_workstr + 'Player Name Unknown';
        if boi_usereal then io_workstr := io_workstr + ', ' + boi_realname;

        { set stat line to 79 characters }
        io_workstr[0] := chr(79);

        case boi_statmode of
            sm_time : if boi_usetime then
              begin { show time remaining in 1/10ths of minutes }
                tempstr := 'Time: ' + tempstr;
                Move(tempstr[1],io_workstr[68],12)
              end;
            sm_help1 : { show help line }
              begin
                io_workstr :=
 '[F2] toggle   [F7] less time   [F8] more time   [F9] hang up   [F10] exit';
                Str(boi_ticks/1092:6:1,tempstr);
                io_workstr := io_workstr + tempstr
              end;
            sm_comm : { show current remote communications parameters }
                Move(boi_cstr[1],io_workstr[80 - Length(boi_cstr)],
                    Length(boi_cstr));
            sm_vid : { show current remote video mode }
              begin
                tempstr := ' Remote Video: ';
                case boi_r_grmode of
                    gr_ascii : tempstr := tempstr + 'ASCII';
                    gr_ansi  : tempstr := tempstr + 'ANSI';
                    gr_avt   : tempstr := tempstr + 'AVATAR';
                    else       tempstr := tempstr + 'Unknown';
                  end;
                Move(tempstr[1],io_workstr[80-Length(tempstr)],Length(tempstr))
              end
          end;

        if boi_l_grmode in [gr_ansi,gr_tpcrt] then
          begin  { save current text attribute (windowing saves AVATAR's) }
            GetTextAttr(oldattr);
            ChangeColor((oldattr AND $00FF) OR $0E00)
          end;
        case boi_l_grmode of
            gr_ansi : { ANSI processing }
              begin
                SendLocal(esc + '[s');   { SetPortXY }
                SendLocal(esc+'[25;1H'); { GotoPortXY(1,25) }
                SendLocal(io_workstr);
                SendLocal(esc + '[u')    { ResetPortXY }
              end;
            gr_avt : { AVATAR processing }
              begin
                SendLocal(ctrlv + ctrlw + Chr($FF)); { declare new window }
                SendLocal(ctrll);                    { set attributes }
                SendLocal(io_workstr);
                SendLocal(ctrlv + ctrlw + Chr(io_l_avwin)) { goto old window }
              end;
            gr_tpcrt : { CRT processing }
              begin
                io_tempx := WhereX; { save current window settings }
                io_tempy := WhereY;
                tempmin := windmin;
                tempmax := windmax;
                Window(1,1,80,25);
                GotoXY(1,25);
                SendLocal(io_workstr);
                windmin := tempmin; { restore old window settings }
                windmax := tempmax;
                GotoXY(io_tempx,io_tempy)
              end
          end;
        if boi_l_grmode in [gr_ansi,gr_tpcrt] then { restore old attributes }
            ChangeColor(oldattr)
      end;
    boi_stime := boi_timer    { update stat line time keeper }
  end;  {* UpdateStatLine *}

Procedure CLRPORTSCR; { clears current window }
  var
    cloop : byte;       { temporary looping variable }

  begin {* ClrPortScr *}
    if not boi_local then case boi_r_grmode of { clear remote screen }
        gr_ascii : SendRemote(#12);  { ASCII mode / formfeed }
        gr_ansi  : { ANSI processing }
          begin
            if (io_basey = 1) and (io_endy >= boi_pagelength) then
                { if full window, clearing screen is simple }
                SendRemote(esc + '[2J')
            else for cloop := 0 to io_endy - io_basey do
              begin { clear each line in current window }
                SendRemote(esc + '[' + IntStr(io_endy - cloop,0) + ';1H');
                if cloop < 24 then SendRemote(esc + '[K')
                { if not bottom of screen clear EOL sequence is fine }
                else SendRemote(PadStr('',79))
                { some ANSI drivers scroll window if bottom right character }
                { is manipulated in any way }
              end
          end;
        gr_avt : { AVATAR processing }
          begin
            SendRemote(ctrlv + ctrlh + Chr(io_basey) + Chr(io_basex));
            SendRemote(ctrlv + ctrll + Chr(io_r_textattr AND $7F) +
                Chr(io_endy - io_basey + 1) + Chr(io_endx - io_basex + 1))
          end
      end;
    if boi_local or boi_echo then { clear local screen }
      begin
        case boi_l_grmode of
            gr_ascii : SendLocal(#12); { ASCII mode / formfeed }
            gr_ansi  : { ANSI processing }
              begin
                if (io_basey = 1) and (io_endy >= boi_pagelength) then
                    { clearing full window is easy and quick }
                    SendLocal(esc + '[2J')
                else for cloop := 0 to io_endy - io_basey do
                  begin { clear each individual line }
                    SendLocal(esc + '[' + IntStr(io_endy-cloop,0) + ';1H');
                    if io_endy-cloop < 24 then SendLocal(esc + '[K')
                    { if not bottom of screen clear EOL sequence is fine }
                    else SendLocal(PadStr('',79))
                    { some ANSI drivers scroll window if bottom right }
                    { character is manipulated in any way }
                  end
              end;
            gr_avt : { AVATAR processing }
              begin
                SendLocal(ctrlv + ctrlh + AvStr(io_basey) + AvStr(io_basex));
                SendLocal(ctrlv + ctrll + Chr(io_l_textattr AND $7F) +
                    Chr(io_endy - io_basey + 1) + Chr(io_endx - io_basex + 1))
              end;
            gr_tpcrt : ClrScr { CRT processing }
          end;
        if boi_usename and (not boi_local) and { update Status Line? }
            (((boi_l_grmode = gr_ansi) and (io_endy >= boi_pagelength)) or
            ((boi_l_grmode = gr_tpcrt) and (Hi(windmax) >= boi_pagelength))) then
            UpdateStatLine
      end
  end;  {* ClrPortScr *}

Procedure CLRPORTEOL; { clears current line from cursor to right edge }
  begin {* ClrPortEOL *}
    if not boi_local then case boi_r_grmode of { clear remote line }
        gr_ansi  : SendRemote(esc + '[K');
        gr_avt   : SendRemote(ctrlv + ctrlg)
      end;
    if boi_local or boi_echo then case boi_l_grmode of { clear local line }
        gr_ansi  : SendLocal(esc+'[K');
        gr_avt   : SendLocal(ctrlv + ctrlg);
        gr_tpcrt : ClrEOL
      end
  end;  {* ClrPortEOL *}

Procedure PORTWINDOW( { declare active window }
    x1 : byte;          { leftmost column (1..x2) }
    y1 : byte;          { topmost line (1..y1) }
    x2 : byte;          { rightmost line (x1..80) }
    y2 : byte);         { bottom line (y1..pagelength) }

  begin {* PortWindow *}
    { use internal windowing routines for most situations }
    if ((boi_echo or boi_local) and (boi_l_grmode in [gr_ansi,gr_avt])) or
        ((not boi_local) and (boi_r_grmode in [gr_ansi,gr_avt])) then
      begin { set screen parameters }
        io_basex := x1;
        io_basey := y1;
        io_endx := Max(x1,Min(80,x2));
        io_endy := Max(y1,Min(24,y2))
      end;
    { if local mode uses direct video, then use Borland's windowing locally }
    if (boi_local or boi_echo) and (boi_l_grmode = gr_tpcrt) then
        Window(x1,y1,x2,Min(25,y2));
    GotoPortXY(1,1)
  end;  {* PortWindow *}

Procedure PORTCOLUMNONE; { puts cursor on left side of screen on current line }
  begin {* PortColumnOne *}
    if not boi_local then case boi_r_grmode of { move remote cursor }
        gr_ansi  : SendRemote(esc+'[79D');
        gr_avt   : SendRemote(ctrlv + ctrly + Chr(2) + ctrlv + ctrle + Chr(79))
      end;
    if boi_local or boi_echo then case boi_l_grmode of { move local cursor }
        gr_ansi  : SendLocal(esc+'[79D');
        gr_avt   : SendLocal(ctrlv + ctrly + Chr(2) + ctrlv + ctrle + Chr(79));
        gr_tpcrt : GotoXY(1,WhereY)
      end
  end;  {* PortColumnOne *}

Procedure SETPORTXY;      { saves current cursor position }
  begin {* SetPortXY *}
    if not boi_local then case boi_r_grmode of { save remote cursor }
        gr_ansi : SendRemote(esc+'[s');        { ANSI processing }
        gr_avt  :                              { AVATAR processing }
          begin
            Inc(io_r_avwin);   { declare new AVATAR window }
            SendRemote(ctrlv + ctrlv + Chr(io_r_avwin) +
                Chr(io_r_textattr) + #01#01#25#80);
            SendRemote(ctrlv + ctrlw + Chr(io_r_avwin)) {switch to new window}
          end
      end;
    if boi_local or boi_echo then case boi_l_grmode of { save local cursor }
        gr_ansi : SendLocal(esc+'[s');         { ANSI processing }
        gr_avt  :                              { AVATAR processing }
          begin
            Inc(io_l_avwin);   { declare new AVATAR window }
            SendLocal(ctrlv + ctrlv + Chr(io_l_avwin) +
                Chr(io_l_textattr) + #01#01#25#80);
            SendLocal(ctrlv + ctrlw + Chr(io_l_avwin)) {switch to new window}
          end;
        gr_tpcrt :                             { CRT processing }
          begin
            io_tempx := WhereX;                { store cursor postion }
            io_tempy := WhereY
          end
      end
  end;  {* SetPortXY *}

{ this should only be used after a call to SetPortXY }
Procedure RESETPORTXY;    { restore saved cursor position }
  begin {* ResetPortXY *}
    if not boi_local then case boi_r_grmode of { restore remote cursor }
        gr_ansi : SendRemote(esc + '[u');   { ANSI processing }
        gr_avt  : if io_r_avwin > $00 then  { AVATAR processing }
          begin
            Dec(io_r_avwin);     { retreat to previous AVATAR window }
            SendRemote(ctrlv + ctrlw + Chr(io_r_avwin))
          end
      end;
    if boi_local or boi_echo then case boi_l_grmode of {restore local cursor}
        gr_ansi : SendLocal(esc + '[u');     { ANSI processing }
        gr_avt  : if io_l_avwin > $00 then   { AVATAR processing }
          begin
            Dec(io_l_avwin);      { retreat to previous AVATAR window }
            SendLocal(ctrlv + ctrlw + Chr(io_l_avwin))
          end;
        gr_tpcrt : GotoXY(io_tempx,io_tempy) { direct video processing }
      end
  end;  {* ResetPortXY *}

Procedure DOTIMEOUT(     { BOI has timed out do to inactivity }
    ringbell : boolean);   { if not Async timout, send ^G (bell) }

  begin {* DoTimeOut *}
    if ringbell then SendString(bell,true);
    ClrScr;
    SendLocal('Program timeout.  ');
    if Carrier then SendLocal('No input for 2 minutes.'+#$0D#$0A)
    else SendLocal('Carrier Dropped.'+#$0D#$0A);
    SendLocal('Returning control to BBS.'+#$0D#$0A);
    Halt                  { Crank up the Exit Procedure chain }
  end;  {* DoTimeOut *}

Function LEFTTIME : integer;    { returns number of minutes left to play }
  begin {* fLeftTime *}
    if boi_ticks <= 0 then { time has expired }
      begin
        boi_timeover := true;
        LeftTime := -1
      end
    else LeftTime := longint(boi_ticks) div 1092 { convert to minutes }
  end;  {* fLeftTime *}

Var
  io_nextexit    : pointer; { pointer to hold address of next Exit procedure }
  io_oldtextattr : word;    { hold initial text attributes of local console }

{$F+}
Procedure IOEXIT;
  begin {* IOExit *}            { unit exit code }
    exitproc := io_nextexit;      { reset chain of Exit Procedures }
    textattr := io_oldtextattr;   { reset original text attributes }
    Window(1,1,80,25);
    GotoXY(1,25);                 { put cursor at bottom of the screen }
    ClrEOL;
    NormVideo
  end;  {* IOExit *}
{$F-}

begin {* uIOLib *}           { unit initialization code }
  directvideo := (boi_tasker in [notask,dos5]);
  io_oldtextattr := textattr;  { store current local text attributes }
  io_l_textattr  := textattr;  { set local text attribute variable }
  io_r_textattr  := textattr;  { set remote text attribute variable }
  io_nextexit    := exitproc;  { save current Exit Procedure chain }
  exitproc       := @IOExit    { add IOLib to Exit Procedure chain }
end.  {* uIOLib *}